home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tprandm.zip / RANDOM.PAS < prev   
Pascal/Delphi Source File  |  1991-12-28  |  3KB  |  108 lines
  1. {$R-}    {Range checking off}
  2. {$B-}    {Boolean complete evaluation off}
  3. {$S-}    {Stack checking off}
  4. {$I-}    {I/O checking off}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}    {Var-String Checking off}
  7.  
  8. {
  9. ==============================================================
  10. Random number generator
  11.  
  12. Released to public domain by Marc Perkel * No Right Reserved
  13. 417-866-1222
  14.  
  15. This program generates 31 bit random numbers and does a darn good
  16. job of it. Included here is a program that tests the randomness of
  17. the numbers it generates.
  18.  
  19. A computer can't actually generate random numbers. The idea is to
  20. generate numbers with an even distribution starting with a seed. To
  21. help in the process, you want to take advantage of every random
  22. event you can.
  23.  
  24. The formula came out of a book which suggested a bit shift method of
  25. generating numbers. It said that for a 31 bit shift that 8 values
  26. were tested that worked very good. I use all 8 of them.
  27.  
  28. I not only start with the dos timer but access it regularly to help
  29. increase the randomness. System variations like file access,
  30. processor speed variations ect make the timer not syncronous with
  31. the program.
  32.  
  33. The SHUFFLE routine should be called in the keyboard idle loop. This
  34. takes advantage of pressing keys as random events.
  35.  
  36. ==============================================================
  37. }
  38.  
  39.  
  40. Program Rand;
  41.  
  42. Const
  43.   RandBit : Array[0..7] of LongInt
  44.             = ($40,$80,$100,$4000,$80000,$2000000,$4000000,$20000000);
  45.  
  46. Var
  47.   LastRandom  : LongInt;
  48.   RandMask    : LongInt;
  49.   DosTimer    : LongInt absolute 0:$46C;
  50.  
  51.  
  52. Procedure Randomize;
  53. begin
  54.    if ((LastRandom and 1) <> 0) xor ((LastRandom and RandMask) <> 0)
  55.       then LastRandom := LastRandom + $80000000;
  56.    LastRandom := LastRandom + DosTimer;
  57.    LastRandom := LastRandom shr 1;
  58. end;
  59.  
  60.  
  61. Procedure Shuffle;
  62. var X : Byte;
  63. begin
  64.    X := LastRandom and 7;
  65.    RandMask := RandBit[X];
  66.    for X := 1 to ((DosTimer + X) and $1F) + 23 do Randomize;
  67. end;
  68.  
  69.  
  70. Function Random : LongInt;
  71. begin
  72.    Shuffle;
  73.    Random := LastRandom;
  74. end;
  75.  
  76.  
  77. Procedure TestRandom;
  78. Var
  79.    Counter : Array [0..255] of LongInt;
  80.    X       : LongInt;
  81.    SumSq   : LongInt;
  82.  
  83. Const
  84.    Loops   : LongInt = 8192;
  85.  
  86. { Uses sum of squares method }
  87.  
  88. begin
  89.    Writeln;
  90.    Write('Computing ',Loops,' Random Numbers ... ');
  91.    SumSq := 0;
  92.    for X := 0 to 255 do Counter[X] := 0;
  93.    for X := 1 to Loops do inc(Counter[Random and $FF]);
  94.    for X := 0 to 255 do SumSq := SumSq + (Counter[X] * Counter[X]);
  95.    Writeln;
  96.    Writeln;
  97.    X := Loops div 256;
  98.    Writeln('Random Factor: ',(X * X * 256 * 100 div SumSq));
  99.    Writeln;
  100.    Writeln('Good random factors are from 90 - 99.');
  101.    Writeln;
  102. end;
  103.  
  104.  
  105. begin
  106.    TestRandom;
  107. end.
  108.